home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Leser 15 / Amiga Plus Leser CD 15.iso / Tools / Development / AmigaTalk_X / intuition / GadTools.st < prev    next >
Encoding:
Text File  |  2002-03-13  |  12.9 KB  |  390 lines
  1. " --------------------------------------------------------------------- " 
  2. " GadTools class is the Parent class that interfaces AmigaTalk to the   "
  3. " gadtools.library in AmigaDOS.                                         "
  4. " --------------------------------------------------------------------- " 
  5.  
  6. Class GadTools :Glyph ! intuiMsgObj windowObj visualInfoObj !
  7. [
  8.    drawBoxFrom: sPoint to: ePoint tags: tagArray ! x y w h !
  9.       " This is a beveled box.  The tags will say whether it's recessed or not "
  10.       x <- sPoint x. " These are NOT checked against window boundaries "
  11.       y <- sPoint y.
  12.       w <- ePoint x.
  13.       h <- ePoint y.
  14.       
  15.       <primitive 239 2 windowObj x y w h tagArray>
  16. |
  17.    beginRefresh
  18.       <primitive 239 3 2 windowObj>
  19. |
  20.    endRefresh: completeFlag
  21.       <primitive 239 3 3 windowObj completeFlag> " completeFlag = true or false"
  22. |
  23.    getIMsg
  24.       ^ intuiMsgObj <- <primitive 239 3 4 windowObj>
  25. |
  26.    replyIMsg
  27.       <primitive 239 3 5 intuiMsgObj>
  28. |
  29.    refreshWindow
  30.       <primitive 239 3 6 windowObj>
  31. |
  32.    postFilterIMsg
  33.       ^ intuiMsgObj <- <primitive 239 3 7 intuiMsgObj>
  34. |
  35.    filterIMsg
  36.       ^ intuiMsgObj <- <primitive 239 3 8 intuiMsgObj>
  37. |
  38.    windowIs
  39.       ^ windowObj " Tell subclasses what Window they are attached to "
  40. |
  41.    registerTo: aWindowObject
  42.       ^ windowObj <- aWindowObject
  43. |
  44.    visualInfoObject
  45.       ^ visualInfoObj
  46. |
  47.    freeVisualInfo
  48.       <primitive 239 3 0 visualInfoObj>. 
  49.  
  50.       " visualInfoObj cannot be used after this unless you perform
  51.       * getVisualInfo:tags: again
  52.       "
  53.  
  54.       ^ visualInfoObj <- nil
  55. |
  56.    getVisualInfo: screenObj tags: tagArray
  57.       visualInfoObj <- <primitive 239 3 1 screenObj tagArray>.
  58.  
  59.       (visualInfoObj isNil)
  60.          ifTrue: [ 'ERROR: could NOT obtain visualInfo from screen!' print.
  61.                    ^ nil
  62.                  ].
  63.                  
  64.       ^ visualInfoObj
  65. |
  66.    xxxWaitForSelection
  67.       " Smalltalk code has to call this inside a loop if there
  68.       * is more than one IDCMP event expected.  You do NOT
  69.       * need to use beginRefresh or endRefresh arround this
  70.       * method.  This method will return an Array Object with 
  71.       * two elements:
  72.       *   rval at: 1 -- value of Gadget (Boolean, String, Prop value or item #)
  73.       *                 or Menu String.
  74.       *   rval at: 2 -- Gadget or Menu UserData field.
  75.       *
  76.       * use subclass methods instead.
  77.       "
  78.       ^ <primitive 239 3 9 windowObj>
  79. ]
  80.  
  81. " --------------------------------------------------------------------- " 
  82. " NewGadgets Class is the class that interfaces AmigaTalk to the        "
  83. " new gadgets portion of gadtools.library                               "
  84. " --------------------------------------------------------------------- " 
  85.  
  86. Class NewGadgets :GadTools ! private gadgetList newGadgetObj windowObj !
  87. [
  88.    disposeGadgetList: gadgetListObj
  89.       <primitive 239 0 0 gadgetListObj>
  90. |
  91.    allocateGadgetList
  92.       gadgetList <- <primitive 239 0 1>.
  93.       
  94.       ^ self
  95. |
  96.    createGadgetList
  97.       private <- <primitive 239 0 2 gadgetList>.
  98.  
  99.       ^ self
  100. |
  101.    disposeNewGadget: unNeededNewGadgetObj
  102.       " You will have to keep track of every newGadgetObj returned
  103.       * from makeNewGadget: & use this method on ALL of them 
  104.       * (unless you have memory to burn).  Once you've called
  105.       * addGadgetToList:type:tags:, a newGadgetObj is no longer
  106.       * needed & perhaps you should use this method afterwards:
  107.       "
  108.       <primitive 239 0 7 unNeededNewGadgetObj>.
  109.  
  110.       ^ nil
  111. |
  112.    makeNewGadget: structureArray
  113.       " structureArray is an Array Object with the following
  114.       * elements in the given order:
  115.       *   ele[1]  <- ng_LeftEdge,   ele[2]  <- ng_TopEdge,
  116.       *   ele[3]  <- ng_Width,      ele[4]  <- ng_Height,
  117.       *   ele[5]  <- ng_GadgetText, ele[6]  <- ng_TextAttr,
  118.       *   ele[7]  <- ng_GadgetID,   ele[8]  <- ng_Flags,
  119.       *   ele[9]  <- ng_VisualInfo, ele[10] <- ng_UserData
  120.       *
  121.       *   ele[11] <- NewGadget Type Tag
  122.       *
  123.       *   ele[10] can be any AmigaTalk Object (especially useful
  124.       *   is a Symbol describing a method to call!).
  125.       "
  126.       ^ newGadgetObj <- <primitive 239 0 3 structureArray>
  127. |
  128.    newStructArray: initArray ! newArray !
  129.       " Example usage:
  130.       * gType        <- intuition getGadgetType: #BUTTON_KIND
  131.       * newGadget    <- NewGadgets new
  132.       * vi           <- newGadget visualInfoObject
  133.       * newStruct    <- newStructArray: #( 10 40 100 20 'My Gadget' 
  134.       *                                    textAttrObj 1 myFlags vi userData gType)
  135.       * newGadgetObj <- newGadget makeNewGadget: newStruct
  136.       "
  137.       newArray <- Array new: 11.
  138.       
  139.       newArray at: 1  put: initArray at: 1.
  140.       newArray at: 2  put: initArray at: 2.
  141.       newArray at: 3  put: initArray at: 3.
  142.       newArray at: 4  put: initArray at: 4.
  143.       newArray at: 5  put: initArray at: 5.
  144.       newArray at: 6  put: initArray at: 6.
  145.       newArray at: 7  put: initArray at: 7.
  146.       newArray at: 8  put: initArray at: 8.
  147.       newArray at: 9  put: initArray at: 9.
  148.       newArray at: 10 put: initArray at: 10.
  149.       newArray at: 11 put: initArray at: 11.
  150.  
  151.       ^ newArray
  152. |
  153.    addGadgetToList: gadgetObj type: gType tags: tagArray
  154.       ^ <primitive 239 0 4 gadgetObj newGadgetObj gType tagArray>
  155. |
  156.    setGadgetAttrs: tagArray
  157.       <primitive 239 0 5 private windowObj tagArray>
  158. |
  159.    getGadgetAttrs: tagArray
  160.       ^ <primitive 239 0 6 private windowObj tagArray>
  161. |
  162.    registerTo: aWindowObject
  163.       (aWindowObject isNil)
  164.          ifTrue: [ 'NewGadgets Object given a nil Window object!' print.
  165.                    ^ nil
  166.                  ].
  167.                  
  168.       ^ windowObj <- (super registerTo: aWindowObject)
  169. |
  170.    waitForGadgetValue ! rval !
  171.       " Use the returned Object (or copy it) BEFORE using any method 
  172.       * that uses <primitive 239 3 9 windowObj> again!
  173.       "
  174.       rval <- (super xxxWaitForSelection).
  175.       
  176.       ^ (rval at: 1)
  177. |
  178.    waitForGadgetUserData ! rval !
  179.       " Smalltalk code has to call this inside a loop if there
  180.       * is more than one IDCMP event expected.  You do NOT
  181.       * need to use beginRefresh or endRefresh arround this
  182.       * method.  Any AmigaTalk Object is valid as the
  183.       * UserData stored in the NewGadget.
  184.       *
  185.       * Use the returned Object (or copy it) BEFORE using any method 
  186.       * that uses <primitive 239 3 9 windowObj> again!
  187.       "
  188.       rval <- (super xxxWaitForSelection).
  189.       
  190.       ^ (rval at: 2)
  191. ]
  192.  
  193. " --------------------------------------------------------------------- " 
  194. " NewMenus Class is the class that interfaces AmigaTalk to the          "
  195. " new Menus portion of gadtools.library                                 "
  196. ""
  197. "   Making a menu: "
  198. ""
  199. "   menu <- NewMenus new "
  200. "   menu allocateNewMenu: 3 "
  201. "   menu1Array <- Array new: 6 "
  202. "   menu2Array <- Array new: 6 "
  203. "   intuition  <- Intuition new "
  204. ""
  205. "   menu1Array at: 1 put: (intuition getGadToolAttr: #NM_TITLE)"
  206. "   menu1Array at: 2 put: 'PROJECT' "
  207. "   menu1Array at: 3 put: 0  NO nm_CommKey for a Menu Title! "
  208. "   menu1Array at: 4 put: 0 "
  209. "   menu1Array at: 5 put: 0 "
  210. "   menu1Array at: 6 put: 0 "
  211. ""
  212. "   menu2Array at: 1 put: (intuition getGadToolAttr: #NM_ITEM)"
  213. "   menu2Array at: 2 put: 'Load a file..' "
  214. "   menu2Array at: 3 put: 'L' "
  215. "   menu2Array at: 4 put: 0 "
  216. "   menu2Array at: 5 put: 0 "
  217. "   menu2Array at: 6 put: 0 "
  218. ""
  219. "   menu fillNewMenuItem: 1 with: menu1Array "
  220. "   menu fillNewMenuItem: 2 with: menu2Array "
  221. ""
  222. "   You MUST have one of these for a valid menu strip: "
  223. "   menu fillNewMenuItem: 3 with: (menu endOfMenuArray: intuition) "
  224. ""
  225. "   chk1 <- menu createMenuStrip: tagArray1 -- CreateMenusA() tags apply here "
  226. "   chk2 <- initializeMenus: tagArray2      -- LayoutMenusA() tags apply here "
  227. " --------------------------------------------------------------------- " 
  228.  
  229. Class NewMenus :GadTools ! private newMenuArrayObj windowObj !
  230. [
  231.    disposeMenu
  232.       <primitive 239 1 0 private newMenuArrayObj>
  233. |
  234.    allocateNewMenu: numItems ! chk !
  235.       " newMenuArrayObj is an Array of NewMenu objects "
  236.  
  237.       chk <- <primitive 239 1 1 numItems>.
  238.  
  239.       (chk isNil)
  240.          ifTrue: [ 'Did NOT allocateNewMenu:' print].
  241.          
  242.       ^ newMenuArrayObj <- chk
  243. |
  244.    endOfMenuArray: intuitionObj ! endArray !
  245.       endArray  <- Array new: 6.
  246.  
  247.       endArray at: 1 put: (intuitionObj getGadToolAttr: #NM_END).
  248.       endArray at: 2 put: nil. " NO nm_Label        "
  249.       endArray at: 3 put: nil. " NO nm_CommKey      "
  250.       endArray at: 4 put: 0.   " NO nm_Flags        "
  251.       endArray at: 5 put: 0.   " NO nm_MutualExclude"
  252.       endArray at: 6 put: 0.   " NO nm_UserData     "
  253.  
  254.       ^ endArray
  255. |
  256.    xxxMakeArray: t k: k f: f x: ex data: data ! rval !
  257.       rval <- Array new: 6.
  258.  
  259.       rval at: 2 put: t.
  260.       rval at: 3 put: k.
  261.       rval at: 4 put: f.
  262.       rval at: 5 put: ex.
  263.       rval at: 6 put: data.
  264.       
  265.       ^ rval
  266. |
  267.    initMenuArray: intObj title: title key: commKey flags: flags 
  268.                        exclude: mx   data: userData ! rval !
  269.       " Make a new Menu: "
  270.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData
  271.  
  272.       rval at: 1 put: (intObj getGadToolAttr: #NM_TITLE).
  273.       
  274.       ^ rval
  275. |
  276.    initMenuItemArray: intObj title: title key: commKey flags: flags 
  277.                            exclude: mx   data: userData ! rval !
  278.       " Make a new MenuItem: "
  279.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData
  280.  
  281.       rval at: 1 put: (intObj getGadToolAttr: #NM_ITEM).
  282.       
  283.       ^ rval
  284. |
  285.    initSubItemArray: intObj title: title key: commKey flags: flags 
  286.                           exclude: mx   data: userData ! rval !
  287.       " Make a new SubItem: "
  288.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData
  289.  
  290.       rval at: 1 put: (intObj getGadToolAttr: #NM_SUB).
  291.       
  292.       ^ rval
  293. |
  294.    initMenuImageArray: intObj title: title key: commKey flags: flags 
  295.                            exclude: mx   data: userData ! rval !
  296.       " Make a new MenuItem: "
  297.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData
  298.  
  299.       rval at: 1 put: (intObj getGadToolAttr: #IM_ITEM).
  300.       
  301.       ^ rval
  302. |
  303.    initSubImageArray: intObj title: title key: commKey flags: flags 
  304.                           exclude: mx   data: userData ! rval !
  305.       " Make a new SubItem: "
  306.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData
  307.  
  308.       rval at: 1 put: (intObj getGadToolAttr: #IM_SUB).
  309.       
  310.       ^ rval
  311. |
  312.    fillNewMenuItem: itemNumber with: structureArray
  313.       " structureArray is an Array Object with the following
  314.       * elements in the given order:
  315.       * ele[1] <- nm_Type,          ele[2] <- nm_Label,
  316.       * ele[3] <- nm_CommKey,       ele[4] <- nm_Flags,
  317.       * ele[5] <- nm_MutualExclude, ele[6] <- nm_UserData 
  318.       *
  319.       * ele[6] can be any AmigaTalk Object (especially useful
  320.       * is a Symbol describing a method to call!).
  321.       "
  322.       (<primitive 239 1 2 itemNumber structureArray newMenuArrayObj> ~= true)
  323.          ifTrue: [ self disposeMenu.
  324.                    'ERROR:  Could NOT fill a NewMenu entry!' print.
  325.                    ^ nil
  326.                  ] 
  327. |
  328.    createMenuStrip: tagArray ! chk !
  329.       chk <- <primitive 239 1 3 newMenuArrayObj tagArray>.
  330.       
  331.       (chk isNil)
  332.          ifTrue: [ 'Did NOT createMenuStrip:' print.
  333.                    ^ nil
  334.                  ].
  335.          
  336.       ^ private <- chk
  337. |
  338.    visualInfo
  339.       ^ (super visualInfoObject)
  340. |
  341.    initializeMenus: tagArray ! chk viObj !
  342.       " This method returns true if successful, false if the menus
  343.       * could NOT be laid-out, nil if there is an error condition.
  344.       "
  345.       viObj <- self visualInfo.
  346.       chk   <- <primitive 239 1 4 private viObj tagArray>.
  347.  
  348.       (chk ~= true)
  349.          ifTrue: [ 'Did NOT initialize NewMenus object!' print.
  350.                    ^ false
  351.                  ].
  352.       ^ true
  353. |
  354.    waitForMenuString ! rval !
  355.       " Smalltalk code has to call this inside a loop if there
  356.       * is more than one IDCMP event expected.  You do NOT
  357.       * need to use beginRefresh or endRefresh arround this
  358.       * method.
  359.       *
  360.       * Use the returned Object (or copy it) BEFORE using any method 
  361.       * that uses <primitive 239 3 9 windowObj> again!
  362.       "
  363.       rval <- (super xxxWaitForSelection).
  364.       
  365.       ^ (rval at: 1)
  366. |
  367.    waitForMenuUserData ! rval !
  368.       " Smalltalk code has to call this inside a loop if there
  369.       * is more than one IDCMP event expected.  You do NOT
  370.       * need to use beginRefresh or endRefresh arround this
  371.       * method.  Make sure that you use only AmigaTalk Objects
  372.       * as the UserData stored in the NewMenu.  This method will
  373.       * return nil if the Menu Item selected was NULL.
  374.       *
  375.       * Use the returned Object (or copy it) BEFORE using any method 
  376.       * that uses <primitive 239 3 9 windowObj> again!
  377.       "
  378.       rval <- (super xxxWaitForSelection).
  379.       
  380.       ^ (rval at: 2)
  381. |
  382.    registerTo: aWindowObject
  383.       (aWindowObject isNil)
  384.          ifTrue: [ 'NewMenus Object given a nil Window object!' print.
  385.                    ^ nil
  386.                  ].
  387.                  
  388.       ^ windowObj <- (super registerTo: aWindowObject)
  389. ]
  390.